(FILECREATED "24-AUG-73 21:51:29" NEWGEN)


  (LISPXPRINT (QUOTE NEWGENVARS)
              T)
  (RPAQQ NEWGENVARS ((FNS NOFVRINGS' RINGS' FVPARTITIONS' VALENCE' 
                          CLBYVALENCE' PARTFVS ALTRINGS PARTFV1)))
(DEFINEQ

(NOFVRINGS'
  [LAMBDA (CLL)
    (for STRUC in (NOFVRINGS (for X in CLL collect CLCOUNT))
       join (STRUCTURESWITHATOMS CLL STRUC])

(RINGS'
  [LAMBDA (FVCL CLL)
    (if FVCL
        then (for FVP' in (FVPARTITIONS' CLL FVCL)
                join (for S in (NOFVRINGS' FVP') collect S))
      else NOFV-RINGS' CLL])

(FVPARTITIONS'
  [LAMBDA (CLL FVCL)
    (for FVP in (FVPARTITION1 (CLCOUNT FVCL)
                              (for X in CLL::1 collect CLCOUNT)
                              1)
       join (for FVP' in (PARTFVS
                           <NIL ! (for X in FVP collect REVERSE)>
                           FVCL CLL)
               collect (CLBYVALENCE' FVP'])

(VALENCE'
  [LAMBDA (X)
    (VALENCE X:1)
    -(CLCOUNT X::1])

(CLBYVALENCE'
  [LAMBDA (CL)
    CL←(GROUPBY (FUNCTION [LAMBDA (PR)
                    (VALENCE' PR:1])
                CL)
    (PROG ((MAXI -999))
          (for PR in CL when PR:1 GT MAXI do MAXI←PR:1)
          (RETURN (for I from 2 to MAXI collect (LMASSOC I CL NIL])

(PARTFVS
  [LAMBDA (FVPART FVCL CLL)
    (if FVPART and CLL
        then (for FV1 in (CLPARTS FVCL (TD FVPART:1 1))
                join (for P1 in (PARTFV1 <(CLCOUNT CLL:1) -(SUM 
                                                           FVPART:1)
                                           ! FVPART:1>
                                         FV1 CLL:1 0)
                        join (for RL in (PARTFVS FVPART::1
                                                 (CLDIFF FVCL FV1)
                                                 CLL::1)
                                collect <! P1 ! RL>)))
      else '(NIL])

(ALTRINGS
  [LAMBDA (U CL)
    (RINGS' <<'FV ! (COMPUTEFV U CL)>> (CLBYVALENCE CL])

(PARTFV1
  [LAMBDA (FVL FVCL CL NFV)
    (if FVCL and FVL and CL
        then
         [for R1 in (CLPARTS FVCL NFV*FVL:1)
            join
             (for R2 in (CLPARTS CL FVL:1)
                join (for R4 in (CLEQUALPARTS R1 FVL:1 NFV)
                        bind R5
                        join (for R6
                                in [CLPARTITIONS
                                     R2
                                     (CDRLIST (R5 ←(CLCREATE R4]
                                join (for RESTPART
                                        in (PARTFV1 FVL::1
                                                    (CLDIFF FVCL R1)
                                                    (CLDIFF CL R2)
                                                    NFV+1)
                                        collect
                                         <! RESTPART !
                                            (for FVPART in R5
                                               as ATPART
                                               in R6
                                               join (for ATPAIR
                                                       in ATPART
                                                       collect
                                                        <<ATPAIR:1
                                                          ! FVPART:1> ! 
                                                         ATPAIR::1>))>]
      else <(for PR in CL collect <<PR:1> ! PR::1>)>])
)
STOP